ANnnnno 


RRRRRRRRRRRR 
RRRRRRRRRRRR 
RRRRRRRRRRRR 
RRR 

RRR RRR 
RRR RRR 
RRR RRR 
RR RRR 
RRR RRR 
RRRRRRRRRRRR 
RRRRRRRRRRRR 
RRRRRRRRRRRR 
RRR =RRR 

RRR = RRR 

RRR = RRR 

RRR RRR 
RRR RRR 
RRR RRR 
RRR RRR 
RRR RRR 
RRR RRR 


AHA tt tt Ht tt SH 
a | LLL) 
ee ee ee Le) 


L 
LLLLLLLLLLLELLLL 


LLLLLLLLLLLLLLL 
LLLLLLLLLLLLLLL 


**F JLE**1D**BASUDFRL 


BBBBBBBB AAAAAA SSSSSS5S UU UU DDDDDDDD FFFFFFFFFF RRRRRRRR LL 
BBBBBBBB AAAAAA SSSSSSSS UU UU DDDDDDDD FFFFFFFFFF RRRRRRRR LL 
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BB AA Aa SS UU UU DD DD FF RR RR LL cece 
BBBBBBB3 AA AA SSSSSSSS UUUUUUUUUU = DDDDDDDD FF RR RR LLLLLLLLLL eeee 
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| BASSSUDF _RL 16-Sep-1984 01:20: AX-11 Bliss-32 V4.0-74 Page 1) 
13-808= 1382 01:80:28 BASRTL.SRCJBASUDFRL o33 1 . 1), 

pe 001 0 MODULE BASSSUDF_AL ( ! BASIC List-directed input, UDF level | 
; ¢ 3h 0 “fo ENT = '1-075' ! File: BASUDFRL B82 Ed} e MOL 1075 r 
wee 004 1 BEGIN 

ye ee hy 

: ; 0007 } ""epainadap orl enact eta et e812 PONG i 
° :® ® 
3 9 0009 1 !* COPYRIGHT (c) 1978, 1980, 1982, 1984 B * 
: 10 0010 1 !* DIGITAL EQUIPMENT CORPORATION, MAYNARD. MASSACHUSETTS. * 
: 1} Bota ; ;* ALL RIGHTS RESERVED. * 
Ps : 7 
HY ig 8018 1 !* THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED * 
3; | 614 0014 1 !* ONLY IN ACCORDANCE WITH R F SUCH LICENSE AND WITH THE * 
. 0015 1 !* INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS ont on ANY OTHER * 
H 18 0016 1 !* COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY * 
3 1 0017 1 !* OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY * 
3 18 Bots : + TRANSFERRED. * 
P 3 & 
3 20 0020 1 !* THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE w 
3 21 0021 1 !* AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT * 
$ $8 o056 : 7. CORPORATION. * 
3 ie a 
3 24 0024 1 !* DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS * 
4 $2 Bose } i: SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL. * 
Py H e 
ces av 0027 1 !* * 
3 $8 3 : leeeeentententeatennennennennenerententettetrnntentntnntentnennernnttntenets 
: 30 $030 by 

; 1 0031 1 !4+ 

; 2 4 1 ! FACILITY: BASIC support Library - not user callable 

_ 0033 1! 

.. 0034 1 ! ABSTRACT: 

» 0035 1! 

3 36 0036 1! This module implements BASIC read List-directed 1/0 statement 

= a 0037 1! at the UDF level of abstraction. This module calls the List- 

$ $ 54 : : directed record routines at the record level to read a record. 

3 re re ! | ENVIRONMENT: User access mode, reentrant AST level or not 

; ri} 744 : AUTHOR: Donald G. Petersen, CREATION DATE: 23-MAR-78 

; 044 1 ' MODIFIED BY: 

; «645 045 1! 

; 46 004 1! DGP, + ow nl VERSION 0 

: 647 0047 1! 1 origin 

; 48 0048 1! 1-02 - than e ‘. JSB p Linkages. DGP 14-Nov-78 

; 49 0049 1 ! 1-004 - Update © ceexe "get oe no tise and add device names to REQUIRE 

; 0050 1! files. 

s; oY 0051 1 ! 1-005 = Change REQUIRE ite names from FOR... to OTS... JBS 07-DEC-78 

; 26 0036 : 1-006 - change new statement types for ineut OLINE and LINPUT. DGP 

; 54 054 1! 1-007 - Change UDF. RL1 to use dispatch tables to get to REC level. DGP 
oa 32, | i 1-008 = Add the functionality to get INPUT LINE rly. DGP 

3 ! 1- - e necessary functio © ge roperly. 

; 0087 1 | 19-Dec=78 ' r™s — 
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BASSSUDF _RL 16-Sep-1984 01:20: AX-11 Bliss-32 V4.0-74 
wd 13-808-198¢ 91:80:23 BASRIL SRE IBASUDF RY 4551 
H 8 00 1 ! 1-009 = Bug fix. DGP 20-Dec-78 
; °5 $38 1! 1- \9 = Add support for longwords. DGP g8-Deca7é 
; 060 1 ! 1-011 = Add error signal to UDF_WL1 (BASSK_ILLNUM). bgp 28-Dec-78 
> «661 061 1! 1- \¢ - Fix bug in Input integer (word). BGP 02-Jan- 
; 6¢ bO¢ 1: 1-015 = Change ISBSA_BUF_PTR, , BUF _END to LUB. DGP 05-Jan-79 
; 6 66 poe 1 ! 1-014 = Make some glean edi ased on the code review. 
; 664 064 1! JBS for DGP. O09-JAN-1 
s & 0065 1 ! 1-015 = Correct some typos. JBS 10-JAN-1979 
5; & Bp08 1! 1513 - Expand on some comments. DGP 15-Jan-79 
; OF 0067 1 ! 1-017 = Add code to handle “Z for INPUT LINE pro oclys DGP 15-Jan-79 
; 0068 1! 1I- 18 - Fix bug in foturn ion text string from GETFIELD. DGP 16-Jan-79 
; §? 4 1! 1-019 - coenge SIGNAL to STOP for ILLNUM in GETFIELD. DGP pe Cel ha 
3 0 070 1! 1- $y - Use BASIOERR.REQ to define the 1/0 error codes. JBS 20-FEB-1979 
. OF71 1 ! 1-021 = Modify GETFIELD to strip off ogding and trailing spaces and tabs 
3 ue ours 1! from unquoted strings. DG =-Feb-/9 
; 0075 1! 1-086 - Change update of BUF_PTR for text in GETFIELD. DGP 06-Mar-79 
>; «674 0074 1 ! 1-025 = Strip all leading spaces and tabs from any text string before check- 
ae 0075 1! ing for del miting quotes. DGP 15-Mar-79 
; 0076 1 ! 1-024 = Change PRINT_ o longword. DGP 19-Mar-79 
3 a Bnee ’ 1-025 - Bon a ~ semicolon as numeric field separator on Input. DGP 
D4 4 -ADre@= 
; He ite : 1-026 - sit is is not a terminal device, then ignore the prompt. 06-Apr-79 
: 0081 1! ae 14 = Change call to BASSS$STOP to BASS$STOP_I0. DGP 16-Apr-79 
; § 0082 1 ! 1-028 - Change a few error messages. DGP 07-May-79 
t- @ 0083 1! eS 9 = Change OTS$S to STR$. JBS 23-MAY-1979 
>; (84 0084 1 ! 1-030 = BASSSUDF_RL1 returns a status. DGP 06-Jun-79 
; 85 0085 1 ! 1-031 - Fix up BASSSUDF_RL1 to support MAT INPUT. DGP 14-Jun-79 
s 8% 0086 1! 1-036 - Use language-specific dispatch tables. JBS 26-JUN-1979 
, oY 0087 1 ! 1-033 - Improve the comments. OGP 28-Jun- 
; @8 0088 1 ! 1-034 - Use ISB Systets for dispatch tables. JBS 12-JUL-1979 
a 0089 1 ! 1-035 = Change calls to STRSCOPY. JBS 16-JUL-1979 
; 0090 1 ! 1-036 = Change from FORS input conversion routines to OTS$. DGP 17-Jul-79 
; wh 0091 1 ! 1-037 - Remove reference to BASS$SIGDIS_ERR. JBS 01-AUG-1979 
‘. v 0092 1 : 1-038 - Set “don't round’ flag for single precision floating when calling 
; 0093 1! the input conversion routine. DGP 07-Aug-79 
; (94 0094 1 ! 1-039 - UDF_RLO should dispatch to the REC level. DGP 07-Aug-79 
3.6 6S 0095 1 ! 1-040 - Set the prompt buffer size to 0 for MAT INPUT if REC level returns 
; © 00 1! a failure. DGP 07-Aug-7 
5 6 6T 0097 1 ! 1-041 = Strip off leading and trailing nulls from input. DGP 29-Aug-79 
5; 0098 1! ef = Unconditionally clear the proses buffer after every GET. DGP 03-Sep-79 
> 0099 1 ! 1-045 - Switch the order of K ; B P Se) at 
: 100 0100 1 ! 1-044 = Increase K_WORK_STR_LEN to 512. DGP 10-Sep-79 
; 101 8183 1! 1-22 - Fix bug in INPUT longwords with tabs and spaces. DGP at a pa 
; 4 106 ,s 3 rf - Only look at low byte f RABSL_STV for terminator. DGP 18-Sep-79 
; Ww 0103 1 ! 1-047 = Clear LUBSL_PRINT_POS just before the GET is done. DGP 18-Sep-79 
: 104 0104 1 ! 1-048 = Prompt ng should Be using LUBSB_PRINT_POS from LUBSA_BUDDY_PTR so 
3; 105 Big2 1! tha S picks up the right value. “DGP 18-Sep-79 
: 106 196 1 ! 1-049 = Check for comma after quoted string. DGP 09-Oct-79 
3: 107 0107 1 ! 1-050 = Include MAT LINPUT with those Stetgaent types which want to 
3; 108 0108 1! read an entire Line. DGP 12-Oct-79 
3 109 44 1 ! 1-051 = Another attempt at handling quoted strings properly. DGP 18-Oct-79 
; 139 gig ' : 1-052 - 48 bug of jnput string that is only spaces, tabs, or nulls. 
oO . -UCt=- 
: ie bits 1 ! 1-053 = Pass the scale factor to the conversion rout ing DGP 25-Nov-79 
RS 01135 1! 1-338 - Set V_EXP_LETTER for OTSSCVT_T_D. PGP 04-DEC-79 
3 (114 0114 1 ! 1-055 = Correct ifiproper register declaration for scaling. DGP 18-Dec-79 


2 
1 
BASSSUDF _RL 18-56 $1984 01:20: AX-11 Bliss-32 V4.0-74 Page 
Agee! 12-8 08=1 8c 94 38:23 EBASRTL. SRC IBASUDFAL .83 3% . 
; 1- 2$ - Call MTHSDINT_R3 instead of wiweor ope R3 for scaling. DGP ionka’” 
1-057 = Signal DATA FORMAT ERROR instead of ILCEGAL NUMBER. DGP 21-Jan-80 
1-058 - If this is READ or MAT READ then update the data pointer before 
doing the conversion $8 that we are pointing at the next data 
element. DGP 22-Jan-80 
1-059 = Pick up escape sequences from RMS for INPUT LINE. DGP 21-Feb-80 
1-060 = Do not set the cursor position unconditionally to zero. DGP 04-Mar-80 
1-061 - If the terminator is an escape (altmode) and the terminating 
peguence is of length 1, then transfer the escape character for 
og OO does not supply it at the end of the data anymore. 
-Mar- 
1-062 = Fix the problem with inputing (READ, INPUT.....) 
“abc . xyz’ this should give an error because of 123. FM 25-SEP-80 
1-063 = Enable INPUT and kind to take an input longer than K_STR Len bytes. 
Terminal 1/0 is still restricted to 512 bytes. FM 25-SEP-80 
61A and 61B were put in the same packet. 
1-064 - Fix problem in above change. A GIRU should be a GTR. ODGP 03-Feb-1981. 
1-065 = Change some occurences of CCBCLUBSL_PRINT_POS) TO TEMP_CCBCLUBSL_PRINT_POSJ. 
Also, INPUT should cancel any outstanding PRINT formatcharacter 
unless the INPUT was terminated by an escape. PLL 12-Jun-81 
1-066 - A case statement in GETFIELD modified to always return a value 
fag 2 et ce compiler does not give an error message. 
-JUL@> 
64k bytes of data causes a ereseture “out of data’’ message because 
SCANC Length is Limited to 16 bits. Make sure the length always looks 
= or < 64k to GETFIELD. PLL 25-Jul-81 


— 
4 
So 
o 
~ 
a 


1-068 - Add support for byte, g floating, and h floating. PLL 24-Aug-81 
1-069 = Add support for packed decimal. PLL 5-Oct-81 

1-070 - More edits for packed decimal. PLL 29-Dec-81 

1-071 - Correct a typo in renge check on byte. PLL 9-Mar-1982 : 
1-072 = Before calling BASSCVT_T_P, check the decimal rounding/truncation 


bit in the Basic frame. 

1-073 - Add support for ANSI INPUT. Although input is always from a 
terminal, errors should cause the entire statement to be re- 
started not just the specific element. This means that $GET 
occurs at the 0 level rather than level 1. PLL 29-Jul-1982 

1-074 = ANSI INPUT of a single element should signal ‘too Little data’, 
not supply the default for the data type. PLL 27-Sep-1982 

1-075 - allow for terminator space when allocating space for WORK_STR. 
MDL 25-Apr-1984 


DUP EY BS BS ES EEE EE WANN UNNI 2 3 
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Ree ee ee ee ee a a ee a er a ae ee ee ae ee ae ee ee ee ee ee ee ee er er er er ee er 
DVS BS BS BS EES BB BE AAA NANI POPIPNPUNINN 4 
MEW O OONA NEW 0 ODNOU EWR "OO OVNOUS WN“ OOOnou 
a ee ee ee ee a ed ad dd 
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| BASSSUDF _RL 1h-56 -1984 01:20: AX-11 Biiss-32 V4.0-74 Page 4 
1-075 12-3001 be 97:80:23 BASRTL. RC IBASUDFRL -B3 3? . (2) 
157 1 
136 1 : é 
122 ; 8 } SWITCHES: 
189 Shed SWITCHES ADDRESSING_MODE (EXTERNAL = GENERAL, NONEXTERNAL = WORD_RELATIVE); 
6 16 ! LINKAGES: 
64 b168 : 
65 0164 
28 318? REQUIRE *RTLIN:OTSLNK'; ! define all Linkages 
8 0398 : 
9 238 ! TABLE OF CONTENTS: 
0 059 ! 
1 B238 
¢ 059 FORWARD ROUTINE 
0600 
4 0601 ' 
5 B08 } UDF routines 
$ 0604 BASSSUDF_RLO: JSB_UDFO NOVALUE, 
8 0605 BASSSUDF"RL1: CALC_CCB, 
9 0606 UDF_RL1 NDLER, 
0 0607 SASSSUDF_RL9: JSB_UDF9 NOVALUE, 
1 0608 
¢ 0609 ! 
061 routine used by BASSSUDF_RL1 


GETFIELD: CALL_CCB; 
INCLUDE FILES: 


REQUIRE '"RTLML:BASPAR': 
REQUIRE "RTLIN:BASFRAME'; 
REQUIRE "RTLML:OTSISB';: 
REQUIRE 'RILML:OTSLUB’: 
REQUIRE "RTLIN:OTSMAC’: 
REQUIRE "RTLIN:RILPSECT'; 
REQUIRE "RTLIN:BASIOERR': 
LIBRARY "RTLSTARLE'; 


BASIC intermodule parameters 
BASIC frame offsets 
1/0 statement block 
Logical Unit Block 


Macros 

Define DECLARE_PSECTS macro 

Define I/O error codes. 

STARLET Library for macros and symbols 


Oe ee ee ee 


ER DERDERDI DIDI DPIII IA et rc cc ee ee ee ee ee ee ed ed ed ed ed eed 
Soooooe0o OOOO OMMC APcecececs SANS NINN NSIC OO 
SSLESSRLAVLSTSESES 3 


FUN $C OONOUESWN —(DWOO- DBOufwh—o 
a a a ee ee ee a a ee ee ee ee ee de eh ed ed edd 


SOCDOSDOCOSOCO OC OO OOOO OODWE fF OfW- to 


3 MACROS: 
: ; NONE 
i 

4 i EQUATED SYMBOLS: 
06 
4 LITERAL 
09 K_WORK_STR_LEN = 512, : Length of work area for parsing input. | 
10 5 K_NULL = Q, : types of constants which may appear in input record 
11 5 KTCR = 2x'OD', i ASCII <cr> 

\¢ K_ESC = 2X'1B', : ASCII <esc> 

1 8 K_SP = %x'20', ! ASCII <sp> 


reo CF rSCF Fr -- —_ 
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BASSSUDF _RL 6-Sep-1984 01:20: AX-11 Bliss-32 V4.0-74 Page 5 
wi ted 122868 =1 382 94:80:28 BASRTL. RC IBASUDFRL.83 31 . (2) 
; 216 09 K_TAB = 9; ! ASCII TAB 
15 10 7 
1$ 11 BUILTIN 
1 \¢ CVTSP, 
18 1 SCANC; 
1 14 
0 15 : 
1 218 } PSECT declarations 
§ 18 DECLARE_PSECTS (BAS); ! declare PSECTS for BASS facility 
5 0 : 
§ : 1 ! OWN STORAGE: 
5 ¢ : NONE 
8 5 
9 524 : 
31 ; é } EXTERNAL REFERENCES: 
5 
$38 528 EXTERNAL LITERAL 
234 529 BASSK_DATFORERR:UNSIGNED (8), ! Data format error 
35 530 B ILLNUM: UNSIGNED (8), ! Illegal number 
36 531 BASSK_ENDFILDEV:UNSIGNED (8), ! End of file on device 
37 23§ BASSK_MAXMEMEXC: UNSIGNED (8), ! Maximum memory exceeded 
$36 53 BASSK_PROLOSSOR: UNSIGNED (8), ! Program lost sorry 
44 a3 BASSK_TOOLITDAT:UNSIGNED (8); ! Too Little data (ANSI only) 
sei 3 EXTERNAL 
BASSSAA_REC_PRO : VECTOR, ! Dispatch table for REC init. 


BASS$AA_REC-PR1 : VECTOR, i Dispatch table for REC Level 
OTS$$A_CUR_CUB: ADDRESSING_MODE (GENERAL), ! address of currently active LUB/ISB/RAB 
BASSHANDLER; ! just need the address of this 


EXTERNAL ROUTINE 
MTHSDIN 


se 
wr 


Remove fraction after scaling 
signal fatal errors 
signal an error 


LIBSCVTDF, ~ convert double to floating 


STRSCOPY_Dx, Copy a yi by descriptor 
BASSOUT_T_DX_S: NOVALUE, output a tex string ; 
BASSCVT_T_P, convert text to packed decimal 


conversion routines 


' convert ASCII to internal 32 bit integer 
! convert ASCII to internal double precision 
! convert ASCII to internal g spent ine 


MOPUIPIPONIPINOFITUNI POPP nonononny 


uw 


oO 
a 
“” 
Sad 
o 
< 
“ 

‘ 
~ 

' 
ao 
_ 


WN —OOONOUn EWN "OV0OOnou 
ee a a ee a ee et ee ee ee ee ee ee ed ed ed ed od 


ah 4h 4b 4b 4d 4h Ab dd hh dh Ab Abb dh hh ib hh dh eb hb hh eb ih th th Ah hh hh od 


AOAOAOA MANNII & BBE PEPE SPW 
ec ea a ce ee ee ee ee a ee ee ee ee ee ee ee ee ee ee eed ed 


MEW OO OD VNOA UE WN 0 OODNOAMUE WN“ OVDONOuM 


OTSSCVTLTCH, ! convert ASCII to internal lLoating 
; record level routines for List-directed input 
BASSSREC_RSLO: JSB_RECO NOVALUE, ! initialize Input record level 
BASSSREC_RSL9: JSB_REC9 NOVALUE, ! end of Input record level 
LIBSGET_OM, ! get virtual memory 

68 LIBSFREE_vM ' free virtual memory 

5 LIBSMATCR_COND; ! match the condition value 
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; 2 1 66 1 GLOBAL ROUTINE BASSSUDF _RLO ( 

3; ar 1567 1 FORMAT_ADR 

; a : 6 : ): JSBLUDFO NOVALUE = 

; 6 1 26 1 l¢¢ 

; as : 4 : FUNCTIONAL DESCRIPTION: 

; 279 1573 1! Perform UDF level read list-directed 1/0 initialization. 

; 280 1574 1! Initialize module ‘‘own’’ storage in the ISB. 

3 a ! 6 : Call record level processor to get first input record. 

H es : ; ! : FORMAL PARAMETERS: 

; 285 1579 1! FORMAT_ADR.rl.r Not used 

; 286 1580 1! 

; 44 138) : IMPLICIT INPUTS: 

3 4 1388 ; OTSS$SA_CUR_LUB Pointer to current logical unit block (LUB) 
; (291 1585 1 ! IMPLICIT OUTPUTS: 

3 3 1586 1! 

; 2 1587 1! NONE 

; 294 1588 1! 

; 295 1589 1 ! ROUTINE VALUE: 

; 296 1590 1 ! COMPLETION CODES: 

3 er 1591 1! 

; 298 1236 E NONE 

; 299 15935 1! 

; 300 1594 1 ! SIDE EFFECTS: 

; 301 1595 1! 

; 34 1398 1} NONE 

; 1597 1! 

; 304 1598 1 !-- 

; 305 1599 1 

: 306 1600 BEGIN 

: 4 1601 EXTERNAL REGISTER 

; 308 1906 CCB: REF BLOCKC, BYTE); 

; 309 160 

; 310 1604 '¢ 

s STi 1605 ! Call record level routine to read the first record. ; 
3 \¢ 1606 ! The buffer pointers are initialized based on whether the device is 
wy 1607 ! a terminal or not 

; 314 1608 to 

s 3515 1609 

: 316 1610 '¢ ; 

; 317 1611 ! If this is an ANSI INPUT, the RECO level will ask for input. So 
: 318 1o1¢ ! put out the standard prompt. Note: ANSI has no files, so INPUT 
3; 319 161 ! will always be from a terminal. 

: 3h 1615 

: 324 1616 If .CCB CLUBSV_ANSI) 

; 161 THEN 

F 4 1618 BEGIN 

; 5 1619 LOCAL 

: $ 1831 TOSC: VECTOR (2); 

; 328 1622 D_PROMPT = UPLIT (*? °); 
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BASSSUDF _RL 16-Sep-1984 01:20: AX-11 Bliss-32 V4.0-74 
‘org 13-88-1382 01:80:28 BASRTL.SRCJBASUDFR ase 
; 329 1623 TDSCLO] = ZCHARCOUNT ('? '); 
: 0 1624 TDSC 9} = D PROMPT: 
; 331 1625 BASSOUT_T_DR_S(TDSC); 
3 § 19 $ END; 
; $ 16 § JSB_RECO (BASSSAA_REC_PRO + .BASSSAA_REC_PRO [.CCB CISBSB_STTM_TYPE] = ISBSK_BASSTTYLO + 1)); 
: 1650 END; 
TITLE BASSSUDF _RL 
-IDENT \1-075\ 
-PSECT _BASSCODE,NOWRT, SHR, PIC,2 
00 00 20 3F 00000 P.AAA: .ASCII \? \<0><0> 
D_PROMPT= 
~EXTRN BASSK: “DATFORERR 
-EXTRN BASS$K—IL LLNUM BASSK_ENDF ILDEV 
-EXTRN BASSK~MAXMEMEXC 
.EXTRN BAS$K~PROLOSSOR 
.EXTRN BASSK~TOOLITDAT 
sEXTRN BASS$S$AA_REC_PRO 
.EXTRN BASSSAA PRI 
EXTRN OTS$$A_CUR_CUB, BASSHANDLER 
EXTRN MTHSDINT, BASSS$STOP 
-EXTRN BAS$$SI 10, LIBSCVTOF 
-EXTRN STRSCOPY_DX; BASS$OUT_T_DX_S 
EXTRN BASSCVT_T_P, OTSSCVT_TT 
EXTRN OTSSCVT-T"D, OTSSCVT-T 
EXTRN OTSSCVT-T"H, BASSS$RET ASLO 
-EXTRN BASSSREC_RSLO, LIBSGET_V 
-EXTRN LIBSFREE-VM, CIBSMATCH COND 
SE 08 (C2 00000 BAS$$uUDF_RLO:: 
SUBL2 #8, SP 
1 Al AB 04 €1 00003 BBC #4, -95(CCB), 1$ 
6E 02 DO 00008 MOVL #2, 
04 AE EE AF 9€ 90008 MOVAB 0D PROMPT, TDSC+4 
SE DD 0001 PUSHL 
000000006 00 01 FB 90012 CALLS #1, _BASSOUT_T_DX_S 
50 FF71 CB 9A 00019 1$: MOVZBL a143cc ) 
50 0000000060040 b OO1E MOVL  BASS$AA_REC_PRO-104(ROJ, RO 
0000000060040 16 00026 JSB BA ASSSAAy “REC~PROCRO] 
5E 08 CO 900 ADDL2 #8, SP 
05 00030 $B 


: Routine Size: 


49 bytes, 


Routine Base: 


_BASSCODE + 0004 


cc wwe— 
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paseguo exee- ihe P1i8hies | HANS AT Obdeseze Meal os5. ee 


; 3 1631 1 GLOBAL nouT i ee BASSSUDF _RL1 ( 

3 16 § 1 ELEM_TY 

8 i) fee 

3 ¢ 1635 1 FORMAT 

: 3z 1687 |  CALLCCB 

3 al = 

; 5 1638 1 

3 § 1639 1 !e¢ 

3 rtf bo : FUNCTIONAL DESCRIPTION: 

; 349 1946 1 / Return the pont input value to the user 1/0 List element. 

3 50 1643 1: The value obtained from the input record is converted to 

; 23 br ' the type of the List element. 

FH 3g 1646 1 i FORMAL PARAMETERS: 

; 354 1647 1: 

; 355 1648 1! ELEM_TYPE. rhe. v Tyee code of user I/0 List element 

5 56 1649 1: ELEM_SIZE.rlu.v ze of the List element 

: 57 1650 1: ELEM_ADR. rlu.r hae of where to store the element 

; 358 1651 1! Points to a descriptor for a gtring } 

3 23 1636 : FORMAT. rlu.v Format character following a Prompt string 

3 361 1654 1! IMPLICIT INPUTS: 

g o¢ 1655 1! 

; 1656 1! OTSS$A_CUR_LUB Pointer to current pogical unit block (LUB) 

: 364 1657 1: LUBS$L_PRINT_POS Internal cursor posit 

; 365 1658 1: LUBSV_UNIT_D flag to indicate terminal on unit 0 

: 366 1659 1: 

; 367 1660 1 ! IMPLICIT OUTPUTS: 

; 368 1661 1! 

3; i” 1o98 1! LUBSL _PRINT_POS internal cursor position 

3 359 1997 ; RABSB_PSZ size of the Prompt buffer 

a) 1665 1 ' ROUTINE VALUE: 

a 1666 1 | COMPLETION CODES: 

3: 374 1667 1! 

3 375 1668 1: NONE 

3; 376 1669 1! 

: 377 1670 1 ! SIDE EFFECTS: 

3 78 1671 1: 

3; 379 1o7¢ 1! SIGNALS vartous errors for input incompatibility and not enough 

; 380 1673 1! input da 

3 3 162% ! If this oy not a terminal device, then ignore any prompts. 

3 BS 1676 1: NOTICE : ALL foratest device files are allocated the static buffer for 
3; 384 1677 1: parsi ng i.e. no VM is allocated for them (because at the 

: 385 1678 1 tine is routine is called we don't know how Large of input 
: 1679 1: we have!!). This means that the maximum terminal device input 
; 3 1680 1: is x eWORK _STR LEN, anything over this will write over the 

; 388 198) 1! stack. 

; 389 16 ¢ 1 i- 

: 390 16 1 

3; 5391 1684 1 '¢ : d ; ‘ 

3 4 1685 1 ! Be aware that there are two exit petats in this routine. One is from j 
3 Sez 1686 : the Prompt handling section and the other is from the Input handling section 
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; 395 1688 1 

Be i me 

; 38 1691 ELEM_ADR: REF VECTOR; 

; 1996 LOCAL 

; 400 169 BYTES_NEEDED: INITIJAL(0) ! workspac needed 

3 401 1694 WORKSPACE: VECTOR C K_WORK_STR_LEN , BY Fd. if input is K_WORK_STR_LEN or less 
: 40 1695 ! use this space through CHARCONS. 

; 40 1998 CHARCONS: REF VECTOR C , BYTE J,! The space where the parsing of input takes place. 
; 404 169 D_VALUE: VECTOR(4), ! holds binary equivalent of input char. 

; 405 1938 ! for numerics 

3 $08 1g TEMP_CCB : err BLOCK C, BYTE], ! temporary CCB 

3; 4 1700 DSC: BLOCK (C8,BYTEJ, ! Descriptor of parsed element for strings 
; 408 1701 ' need a local descriptor because if a 

3; 409 1706 ' static desc. was passed, the values in 

; 410 170 ! it are not to be changed. 

; 411 1704 UNWIND _VM_SIZE : VOLATILE, ' Size of VM allocated. 

3 216 1705 UNWIND _VM_ADDR : VOLATILE, ! Address of VM allocated for input buffer 
3; (41 1738 ' This buffer is allocated if input size 

3 4146 170 ' is greater than 512. 

3; «415 1708 UNWIND_CCB : VOLATILE; ' CCB for the handler. 

; “19 1740 LITERAL 

; 418 Wi K_ESC = %X'1B'; ! ASCII for escape 

: 420 1518 3 EXTERNAL REGISTER 

; $$ ya CCB: REF BLOCKC,BYTE); 

; 058 1716 : BUILTIN 

s rir 1717 FP; 

oer 

: re 1720 2 Set up a handler for this routine so in case of unwind we can deallocate VM, 

; 43 7s § } if any was allocated. 

; $38 1738 ; "ENABLE UDF_RL1_HANDLER ( UNWIND_VM_SIZE , UNWIND_VM_ADDR , UNWIND_CCB ); 

> 43 1725 2 !+ 

; 134 17$6 ! determine how much workspace is needed. this is the number of bytes in 

3 rt lis? ; } the buffer plus the number of bytes in the terminator. 

: 436 404 ; BYTES_NEEDED = ( (.CCB CLUBSA_BUF_END] - .CCB CLUBSA_BUF_PTR]) + 

§ $32 4 ? ? SeeL EC TONEY ~CCB CRABSW_STVOJ OF 

; 439 1732 2 cates CCB CRABSW_STV2); 

> 441 1734 4 OTHERWISE): $3 

3 a 1736 ve TES) ); 

> 46h 1737 i If space needed for parsing is greater than kK WORK_STR_LEN then we use VM, otherwise 
3 ‘a2 1738 ; we use the static storage allocated in WORKSPACE. 

5 447 1740 IF .BYTES_NEEDED GTR K_WORK_STR_LEN 

: rr 1743 THEN EGIN 

; 450 178 UNWIND_VM_SIZE = .BYTES_NEEDED; 

3 «451 1744 UNWIND-CCB = .CCB; 


$3 
§ 
‘2 | 
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RDSCCDSCSA_POINTER) = .CCBCRABSL_PBF] + .CCBCRABSB_PSZ); 
'¢ 


i adjust the internal cursor position and the resultant peeteg 
& length as determined by the data type and the format character 


cass - FORMA 
oe BASSK_ Semt FORM TO BASS$K_NO_FORM OF 
tbAsse en _F ORM): 


aes ise P_FORM “a e. 1_FORM; 


4 45 IF NOT LIBSGET VM ( UNWIND _VM_SIZE , UNWIND_VM_ADDR ) THEN BASS$S$STOP_IO (BASSK_MAXMEMEXC); 
4 5 rf CHA RCONS = .UNQIND_VM_ADDR> 
454 4 
455 48 LSE 
? : 4 : CHARCONS = WORKSPACE; 
$28 1 : Load up TEMP_CCB with a pointer to the complementary data base for PRINT. 
ree § TEMP_CCB = .CCB CLUBSA_BUDDY_PTRI; 
46 5 IF .FORMAT GTR O 
46 28 THE 
464 BEGIN 
465 58 
$68 59 + 
46 60 ! Check to see if this is a terminal device. If it is, then process the 
468 61 ! prompt; otherwise, just return. 
469 86 t= 
470 6 
471 64 IF .CCB CLUBSV_TERM_DEV] 
47 65 THEN 
47 66 BEGIN 
474 67 
475 68 '¢ 
47 69 ! Prompt 
47 70 t- 
478 71 
479 aS LOCAL 
7 RDSC: BLOCK (8, BYTE); ! Resultant descriptor from Prompt processing 
481 74 LITERAL ; 
48 75 . -PRINT_ZONE_SZ = 14, ! Print zone size 
ret 6 K-CRLF = 2 EK OROD ! ASCII codes for carriage return-Line feed 
78 
79 
80 
4 
85 
84 
85 
86 
87 
88 
94 
0 
4 
35 
94 
95 
96 
7 
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= BASSK_SEM 
498 RDSC psc$Q_CENGTA ELEM_SIZE; 
rhs oe _CCB CCUBSL_PRINT_POS]~= .ELEM_SIZE + .TEMP_CCB CLUBSL_PRINT_POS); 
201 cast town, FOR): 
208 rat ie P_FORM cH H] = BASSK_COMM 
206 3 RDSCCDSCS$O pin sa Ne gBLER M_SIZE + Ack OPRINT _ZONE_SZ = ((.TEMP_CCB CLUBSL_PRINT_POS] + .ELEM_SIZE) | 
H TEMPn¢ eB wrt tiie PRINT_POS) = .TEMP_CCBLLUBSL_PRINT_POS) + .RDSCCDSCS$W_LENGTH); 
0 


[Bass h _NO_ FORM): 
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BASSSUOF RL 1e=ge87 1382 94:88:23 | HAXSAT Ob hes 
; 4 ! ¢ BEGIN 
‘ ! 
; : i : iNeed to leave room for carriage control 
> 54 1806 ie 
; 514 180 
: W_LENGTH] = .ELEM_SIZE + 2 
: 2 i 09 natant pF oRn CH] = BASSK_NO_FORM; 
: 3 1810 TENP_CCBLCUBSL PRINT POS = 0; 
: 1811 4 ; 
; i§ 1818 4 TES; 
; 0 1815 4 te 
; A i is é i Set the address for the destination of the Prompt. Update the RAB 
: 5 § 1817 2 Prompt Buffer Size 
: 524 1 ie 
: 352 i819 1 + .RDSCLDSCSW_LENGTH); 
; 526 1819 4 CCBCRABSB_PSZ) = .CCBCRABS$B_PSZ +. f $ 
; 3 S is : 4 EMSCODY ELEM SIZE ESE ER RDRSED, * "| .RDSCCDSCS$W_LENGTH], .RDSCCDSC$A_POINTER)); 
3 529 1822 4 IF .FORMAT EQLO BAS$K_NO_FORA 
; é 1 18 ¢ é _GRDSCCDSCSA_POINTER] + .ELEM_SIZE)<0, 16> = K_CRLF; 
: 238 is : RETURN 1; 
3; 33 $ 
3 230 \s i END; 
; 238 1880 i* ith i tting a value 
: 335 1880 Sete oich cts deteeas te cures pnother Fiewd out of che INPUT stream based 
: 239 1838 i on the data type. at; a data field cannot ve fovng (empty buffer) 
7, °° i 
: re 1832 i status 1s returned. if a data field is found then a 
; " 1832 etry be rs, the error number is put into the 
; ¢s 1839 1 hae picton. Ue sonet inion peneal to GETFIELD is updated to point to 
; 20? i330 the parsed string and the length field is updated. 
; 58 i IF NOT (GETFIELD( 
; 54 
: 330 1Be i* ference to a quadword for a numeric quantity and 
et 1Be8 a pointer to's descriptor or a string 
eo ik , 
; * M_TYPE 
; $55 1849 4 EROR DESK _BTYPE_ TO DSCSK_DTYPE_H OF 
2% ibe SCSK_DTYPE_W, DSCSK_DTYPE_L, DSCSK_DTYPE_F, 
ee SURETPES: SECEE-RTPEY: BSEE BPE ts 
: ALUE; 
: ef 3 4 Coscae DTYPE_T, DSCS$K_DTYPE_PJ : 
: 268 i 56 4 CINRANGE , OUTRANGE): 
: 388 } 35 ¢ i Data types which are not yet supported 
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3 1859 4 Hoe 

: $e ise) TES 

; $9 1 6 ) 

; 570 186 -ELEM_TYPE, .CHARCONS)) 

s $7) 1864 THEN 

3 f : 65 BEGIN 

3; 574 1 89 ! Try to get another record. Device type checking (forcible or nonforcible) is performed at 

; £? : re] the REC level before a GET is attempted. 

3 38 1890 IF .CCBCLUBSV_UNIT_0) AND NOT .CCB CLUBS$V_ANSIJ 

: 578 1871 THEN 

: t4 4 1376 '¢ 

; 580 187 ! Insert the BASIC default prompt if on unit 0 

; 581 164 !- 

3 one 1875 

; 58 1976 4 BEGIN 

; 584 1877 4 LOCAL 

; 585 1878 4 TOSC: VECTOR (2); 

; 586 1879 4 IND 

; 587 1880 4 PROMPT = UPLIT (‘? '); 

; 4588 1881 4 TDSC 0 = ZCHARCOUNT ('? '); 

; 589 1356 & TOSCC1J = D_PROMPT; 

; 590 1883 4 BASSOUT_T_DR_S(TDSCO); 

3; 591 1884 END; 

3 236 1885 

; 59 1886 + 

; 594 1887 ! Dispatch to the eperger sete REC level routine. If INPUT then get 
; 595 1888 ! another record. If READ then signal an error - should not be out 

; 596 1889 ! of data. If this is a MAT INPUT, try to get another record and pass the status 

3; 597 1890 i back to the UPI Level. Status is determined by whether the current 

; 598 1891 ! record ends with a continuation character. Clear LUBSL_PRINT_POS thru 

; 599 1996 ! BUDDY_PTR so that this INPUT will not affect Later PRINTs or prompting 

; 600 189 ! if there is an error on this GET. 
3 602 He NOTE: There is a RETURN here in the middle of the routine. 
; 60 1896 | 
; 604 1897 4 If (NOT (JSB_REC1 (BASSSAA_REC_PR1 + .BASSSAA_REC_PRIC.CCBCISBSB_STTM_TYPE] - ISBSK_BASSTTYLO + 1))) | 
: 806 ia99 3 te THEN | 
3; 607 1900 !' Clear the Prompt buffer which has been loaded in case another GET was going to 

; 608 1901 ! be done. t is not cleared, then I1/0_END will print it out (10 INPUT ‘Too’ 

; 609 1206 ! ), MAT INPUT is different, because the RTL asks for more data if it is avail- 

; 610 190 ! able. The other types of input demand more data. Therefore, the GET for MAT 

; 611 1904 ! INPUT is only done if the continuation flag is set signifying that the last 

3 oi¢ 1905 ' record ended in an ‘8’. 

3 61 1906 t= 

3 614 1907 4 BEGIN 

3; 615 1908 4 ccB sRABSO_PSEI = 0; 

; 616 1909 4 RETURN 0; 

s 6l7 1910 ; 

3; 618 1911 '¢ ‘ 

; 619 13\§ ! Unconditionally clear the prompt buffer so that a RESUME with no Line number 

3 620 Hb a which restarts an INPUT statement will not keep concatenating prompt strings. 

; 622 1915 CCB CRABSB_PSZ] = 0; 
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: 623 191 

: 624 1319 '¢ 

3 Ge2 191 ! Now that another record has been gotten, call GETFIELD again and ignore 
3; 6 $ 191 ! the return status because it is assumed that failure to return something 
; 6 19 ' is impossible. 

; 628 1921 t= 

; 629 19 ¢ 

3; 6350 19 GETFIELD( 

; 631 1924 4 (CASE .ELEM_TYPE 

: e ¢ 13 5 : on DSCSK_BTYPE_B TO DSCSK_DTYPE_H OF 

; 6 19 3 4 SCS$K_DTYPE_B, DSCSK_DTYPE_W, DSCSK_DTYPE_L, DSCSK_DTYPE_F, 
; 6 5 19 § 4 DS¢Sk DTYPE-D. DSCSK-DTYPE-G, DSCSK-DTYPE_Hd: 
3 637 1930 4 CDSC$R_DTYPE_T, DSCSK_DTYPE_P): 

; 638 1931 4 pst; 

3 639 193¢ 4 CINRANGE, OUTRANGE: 

MOREE bate types vite ; 
3 ' Data es which are not yet supporte 
: gue 1935 4 & ” pest 

: 64 1936 4 0 

3 644 1937 4 TES 

; 645 1938 ; ), 

3 646 1939 -ELEM_TYPE, .CHARCONS) 

3; 647 1940 END; 

3; 648 1941 

; 649 by 

3; 650 194 '+ 

3 $3) I3ee : Store the converted Input data into its new home based on the data type 
; beg 1946 

3 654 1947 2 CASE .ELEM_TYPE 

; 655 1948 2 FROM DSCSK_DTYPE_B TO DSCSK_DTYPE_H OF 

: 656 1949 ab 

; 657 1950 INRANGE, OUTRANGE): 

; 658 1951 '¢ 

3; 659 1936 2 ! Data types which are not supported 

; 660 195 te 

3 661 1954 0; 

3 O66 1955 CDSCSK_DTYPE_B): 

: 66 1956 '¢ 

3: 664 1957 ! Byte 

3: 665 1958 Hd 

3 666 1959 BEGIN 

; & 1960 MAP 

3; 668 1961 ELEM_ADR: REF VECTORC, BYTE); 

3 669 1De6 ELEM_ADRIOJ = .D_VALUE; 

: 670 196 END; 

; 671 1964 CDSC$K_DTYPE_w): 

3; 67 1965 '¢ 

3; 67 1208 ! Integer 

3; 674 196 != 

3; 675 1968 BEGIN 

3; 67 1969 

: 67 1970 ELEM_ADR: REF VECTORC, WORD); 

3; 678 1971 ELEM_ADRTO] = .D_VALUE; 

3; 679 1972 END; 
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CDSC$K -DTYPE_L, DSCSK_DTYPE_FJ: 

. “Lonquoré integer or single precision floating point 


apace = .D_VALUE; 
roscSxD COTYPE , DSCSR_DTYPE_G2: 


"Double ‘calen floating point or g floating 
ELEM MADRO} = .D ~VALUE ESI; 
ELEM. ADRL1) = .D-VALUEL1); 
cDSC$k _DTYPE_HJ: 
i if floating 


IN 
ELEM_ADR[O) = .D_VALUE 03; 
ELEM-ADRE1) = “De “VALUEC 1; 
ELEMADR ¢] = :D“VALUE eae 
ELEM-ADRL3J = 3 “VALUEC3I; 


ND; 
oscéx _bTYPE_T3: 
i" "cherecter string - ELEM_ADR contains the address of the descriptor 


CHARCONS; 
$K_CLASS_S; 
$K-DTYPE_T; 
S 
a 


7 2 
DSCCDSC$B_CLASS] = DS 
DSCCD = DS 
! weeee Change LIB 


D 
STRSCOPY_PX ELEM LD 
IF .(.DSCLDSC$A_POINT 


i 
BEGIN 


'¢ 

i This “2 has been deferred until now so that it could get stored into 
i the users buffer for error handling as required by Basic. Now is 

& the proper time to signal the error. 


cory to inhibit signalling tees 
1)<0,8> EQLU BASSK_CONTROL_2 


CCBLRAB$B_P 
BAS S$STOP_ I 


coscék bTyPE Pl: 
7 “Peched decimal string - ELEM_ADR contains the address of the descriptor 


BEGIN 
LOCAL 
STATUS, 
FLAGS, 
FMP : REF BLOCK CO,BYTE) FIELD (BSFSFCD); 


$2) = 0; 
O(BASS$K_ENDFILDEV); 


32 
BASRTL’S Rie BASUDFRL. -B32; 
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3 wr 0 LITERAL 

H 13 S ? V.DONT_ROUND = 1°3; 

; 740 0 : DSCCDSCSA_POINTER] = .CHARCONS; 

; 741 034 DSCLDSCSB_CLASSJ = DSCSK_CLASS_S; 

; i 5 5 dsc DSCSB_DTYPE] = DSCSK_DTYPE_T; 

3 744 0 ; 1 Call a conversion routine which will handle the semantics of converting 

> 745 038 , text to packed decimal. Pass the decimal round/truncate flag from the 

; 74 039 ! Basic frame as the flags parameter. 
3; 74 040 le | 
; 748 041 FMP = FP; 
; 750 04 
3; 751 044 4 BEGIN ! search for a Basic frame 

; Tag oF 2 FMP = .FMP CBSFSA_SAVED_FP]; 
3; 754 2047 4 UNTIL (.FMP CBSFSA_HANDLER] EQLA BASSHANDLER OR 
; 33 Spee -FMP EQL OJ; | 
> tor 2050 IF (.FMP NEQ 0) AND (.FMP CBSFSW_FCD_FLAGS] AND BSFSM_FCD_RND) NEQ 0 

; 758 2051 THEN 

; 759 sees FLAGS = 0 

; 760 205 ELSE ; 

3 et Spee FLAGS = V_DONT_ROUND; ! set flags according to frame bit 
; reg 2056 ; STATUS = BASSCVT_T_P (DSC, (.ELEM_ADR), .FLAGS); 
3 764 2057 IF NOT .STATUS TREN BASS$STOP_IO TBAS$K_DATFORERR); 

; 765 2058 3 END 

; 766 2059 § TES; 
; 767 2060 CCBERABSB_PS7] = 0; | 
; 768 2061 é . (.CCBCRABSW_STVO] NEQ K_ESC) THEN TEMP_CCBCLUBSV_FORM_CHAR] = 0; 
3 aa 2068 2 : If we have allocated VM for the parsing space then deallocate it here. 
s £2 2065 : IF ( .CHARCONS NEQA WORKSPACE ) 
; 77 2066 THEN 
3 774 2067 BEGIN 

3s 77 2068 IF NOT LIBSFREE_VM ( UNWIND_VM_SIZE , UNWIND_VM_ADDR ) 
: 776 $068 THEN 

: 777 070 4 BEGIN 
; 778 2071 4 UNWIND _VM_SIZE = 0; 
; 779 2078 4 BAS$SSTOP_10 (BAS$K_PROLOSSOR); 

; 780 so? 3 END; 

> «781 074 2 END; 

; 78 2075 2 RETURN 1; 

; 78 2076 1 END; 


00035 -BLKB 3 
00038 P.AAB: <ASCII \? \<0><0> ; 
D_PROMPT= P.AAB 


00 00 20 35F 


07FC 00000 ENTRY BASSSUDF_RL1, Save R2,R3,R4,R5,R6,R7,R8.R9,-; 1631, 
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AC 


:2 ret Bliss-32 oP 6 t 
~ :4 BASRTL. SRC JBASUDFRL.B32;1 
45$-31$,- 
45$-31$.- 
45$-31$.- 
45$-31$.- 
5$-31$.- 
$s- 1$ 
11 0021 BRB 4 
90 0 12 328: MOVB p VALUE, @ELEM_ADR 
11 1 BRB 7$ 
BO 00219 33$: MmOVvW VALUE, @ELEM_ADR 
11 0021 BRB 7$ 
D0 96 34$:  MOVL VALUE, @ELEM_ADR 
11 00 BRB 7$ 
b0 00227 35$: MOVL  ELEM_ADR, RO 
D 00228 MOVa 0 _VACUE, (RO) 
11 002eF BRB 45$ 
b0 00231 36$:  MOVL ELEM_ADR, RO 
D 00235 MOVQ D_VACUE, (RQ) 
7D 99 9 MOVQ D-VALUE+8, 8(RO) 
11 OO23E 37$: BRB 
DO 00240 38$:  MOVL  CHARCONS, DSC+4 
BO 00244 MOVW #270, DSC+2 
OF 0024A PUSHAB DSC 
DD 00g40 PUSHL eL DR 
FB 00250 CALLS #2, STRSCOPY_DXx 
91 00257 CMPB 0s « DSC +4, #2 
12 00258 BNEQ 
94 00250 CLRB =: 52 CCB) 
9A 00260 MOVZBL #BASS$K_ENDFILDEV, -(SP) 
11 00264 BRB 44$ 
DO 00266 39$:  MOVL CHARCONS, DSC+4 
BO 0026A MOVW #270, DSC+2 
DO 00270 MOVL FP, FMP 
DO 00273 40$:  MOVL 12¢FMP), FMP 
9€ 00277 MOVAB BASSHANDLER, R1 
D1 0027E CMPL (FMP), R1 
13 00281 BEQL 41$ 
D5 00283 TSTL FMP 
12 00285 BNEQ 40$ 
DS 00287 41$: TSTL FMP 
13 00289 BEQL 42$ 
E1 00 8B BBC #9, -26(FMP), 42% 
D4 00 CLRL «FLAGS 
11 9 32 BRB 4 
D0 42$:  MOVL #8, FLAGS 
DD 00297 43$:  PUSHL FLAGS 
DD 00299 PUSHL ELEM_ADR 
OF 99 9C PUSHAB 0 
FB 029F CALLS #3, BASSCVT_T_P 
E 0026 LBS.sSséST d 
A 00209 MOVZBL M#BASSK DATFORERR, -(SP) 
FB OO2AD 44$: ALLS #1, BAS$$STOP_IO 
94 00280 45$: CLRB 
B1 0028 CMPW  =s-:« 12. (CCB), #27 
13 0028 EQL 
Bh 0289 BICB2 #4, -2(TEMP_CCB) 
E 002BD 468: OVAB WORKSPACE, RO 


Pe Se Se Se Se Se Se Se Se Ge Ge Se Se Se Se Fe Se Fe Ge Se Se Ge Ge Se Ge Se Fe Be Se Se Se Se Se Se Ge Se Be Be Fe Be Fe Fe Be Be Se Be Be Se Se Se Se Se Se Se Be Se Se 


F 1 
BASSSUDF _RL 16-Sep-1984 01:20: AX-11 Bliss-32 v4.0-7%4 Page 20 
1005 14- ets 7 91:80:23 BASRTL. SRC Bacubray .035:1 - 
50 59 C1 CMPL  CHARCONS, RO ; 
| an 93 bosea BEQL «7S : 
| oar Se ees ua Ung ane _ 
f P 
000000006 00 05 re ce CALLS BSFREE_vM : 
- 10 AE pe 005 OLR, OUUNGIND VM. SIZE : 2071 
7E 006 8F BR 0 3 MOVZBL #BASSK -PROLOSSOR, -(SP) : $072 
A or FB 00200 CALLS BASSSS STOP_10 ; 
0 1 oO 0 EO 47$: MOVL ne + 2075 
04 E RET : | 
50 b4 0 £4 48$:  CLRL RO + 2076 
4 EG RET : 
0000 002E7 49$: «WORD sexs nothing 3 1689 
50 08 AC DO 002E9 MOVL RO : 
50 04 AO BO 002ED MOVL  4(RO). RO : 
FDDC CO 9F O02F1 PUSHAB UNWIND_CCB F 
FDEO CO 99F O02F5 PUSHAB UNWIND~VM_ADDR : 
FDES CO 9F 00F9 PUSHAB UNWIND-VM~SIZE : 
03 DD O02FD PUSHL #3 : 
SE DD O0erF PUSHL SP : 
7E 04 AC 7D 00301 MOV. 4(AP), =(SP) : 
0000v CF 03 FB 00305 CALLS #3, UDF_RL1_HANDLER : 
04 0030A RET : 


; Routine Size: 779 bytes, Routine Base: _BASSCODE + 003C 


784 2077 1 


13 
BASSSUDF _RL 18-5e -1984 01:20: AX-11 Bliss-32 V4.0-74 Page 21 
passguo 12-8 08- 1982 01:80:28 YBASRTL SRe BAsubr ay 35:1 . (8) 
3; 7 ore 1 ROUTINE UDF_RL1_HANDLER ( 'Handeler for bas$udf_rl1 
sr 079 #1 $1G ‘Signal vector 
fe Sl fe aes 
3 ‘Enable vector 
; 790 O8¢ 1 jos 
; «791 0 1 
; 79 084 1 !44 
; 79 8 ‘ : FUNCTIONAL DESCRIPTION: 
: 795 087 1! If we are unwinding and we have given the parsing space VM then 
3 088 1! free this VM. . ° , 7.” 
: 79 089 +1! 
; 798 090 1 ! FORMAL PARAMETERS: 
; 199 091 1! 
; 800 092 1! $1G.rl.ra A counted vector of parameters from LIBSSIGNAL/STOP 
; 801 093 1! MECH. rl.ra A counted vector of info from chf 
3 i B38 : ENBL.rl.ra A counted vector of ENABLE argument addresses. 
; 804 B98 1 ! IMPLICIT INPUTS 
; 805 097 1! 
; 806 098 1! NONE 
3; 807 099 1! 
; 808 100 1 ! IMPLICIT OUTPUTS 
3; 809 101 1! 
; 810 10 1! NONE 
: 811 103 1! 
3 aig 104 1 ! COMPLETION CODES 
3; (UBN 105 1! : 
3 si¢ 198 ; } Always SS$_RESIGNAL, which is ignored when unwinding. 
; 816 108 1 ! SIDE EFFECTS 
; 817 2109 1! 
; 818 2110 1! NONE 
; 819 2111 1°! 
; 820 $118 1 !<- 
; 821 11 1 
3; 822 2114 2 BEGIN 
: 823 sti? 2 
: 824 116 2 P 
3 823 $i! § SIG : REF VECTOR, 
: 826 118 MECH: REF VECTOR, 
3 iH Bh 2 ENBL: REF VECTOR; 
: 8¢) 131 GLOBAL REGISTER CCB = K_CCB_REG : REF BLOCK C,BYTE]; 
3 th : 5 2 CCB = ..ENBL (3); 
: 838 ; H : If we are unwinding and have allocated VM then free it. 
3 B35 \¢¢ Fae NO Come ( SIG C1] , ZREFCSSS_UNWIND) ) AND ( ..ENBL [1] GTRU 0 )) 
3; 837 1 IF NOT LIBSFREE_VM ( .ENBL C1) , .ENBL (2) ) 
; 838 130 THEN BASSSSTOP_TO ( BAS$K_PROLOSSOR ); 
3 $20 13 RETURN (SS$_RESIGNAL); 
3; 841 138 1 END; 


H 13 
ald 1ec$ep-198e 11:56:43 EBASRTL’Sme SBASUDFAL 039; 1 Soy 


0804 00000 UDF_RL1_HANDLER: | 
RD 078 


WO Save R2,R11 : 
52 C aC DO 00002 MOVL ENBL, Re + 2123 
8 : -/ b0 99006 MOVL 81¢(R2), ccB : 
7E 0920 8F 3C OOO0A MOVZWL #2336, -(SP) + 2127 
—E dD 9000F PUSHL SP : 
7E 04 Ac 04 ¢1 00011 ADDL3 #4, SIG, -(SP) : 
000000006 00 92 FB 0016 CALLS #2, LIBSMATCH_COND ; 
iE £9 0001D BLBC ~=E.-s&aRO._*18 : 
04 8B D3 9020 TSTL  @4(R2) : 
19 13 000 BEQL ©:1$ : 
7E 04 A2 70 900 5 MOVG 4(R2) + 2129) 
000000006 00 08 re 900 9 CALLS 2, tfesrnee_ vM | 
7E 006 8F 9A 0003 MOVZBL #BAssx PROLOSSOR, -(SP) + 2130, 
000000006 00 1 FB 00037 CALLS #1, BASSSSTOP_ : | 
50 0918 B&F 3C 0035 1$ MOVZWL #2328, RO + 2131) 
04 0004 RET ; 


2133 
; Routine Size: 68 bytes, Routine Base: _BASSCODE + 0347 


BAstHUDE AL 1Edeo-19gs 01:20:23 


3 3 134 1 GLOBAL ROUTINE BASSSUDF_RL9 
3 rf ! 5 ! : JSB_UDF9 NOVACUE = 
s <3 1 $ 1 !¢¢ 

: of } 3 ! } FUNCTIONAL DESCRIPTION: 
3 830 re : List directed input UDF termination. 
3 51 16g 1 ! FORMAL PARAMETERS: 

; 26 143 1! 

; 85 144 1! NONE 

3; 854 145 1! 

F $2? 166 1 ! IMPLICIT INPUTS: 

; 28 147 1! 

; 8 148 1! NONE 

; 858 149 1! 

; 859 150 1 ! IMPLICIT OUTPUTS: 

3 0 si ae 

3; 861 136 1! NONE 

3 £06 153 1! 

; 86 154 1 ! ROUTINE VALUE: 

; 864 155 1 !' COMPLETION CODES: 

; 865 186 1! 

3; 866 157 1! NONE 

; 867 158 1! 

; 868 159 1 ! SIDE EFFECTS: 

3; 869 160 1! 

: 870 2161 1! NONE 

3 871 196 1! 

3 a7¢ 163 1 !-- 

3; 87 164 1 

3; 874 2165 $ BEGIN 

; 875 2166 

; 876 $162 2 RETURN; 

3; 877 168 1 END; 


05 00000 BASSSUDF _RL9:: 
RSB 


3; Routine Size: 1 bytes, Routine Base: _BASSCODE + 0388 


3 2168 | 


13 
18-Sep-1986 01:20: AX-11 Bliss-32 v4.0-74 
1erge=188 $1 i$ec3 — Fesrre Saeieacubray .o$3-1 


rae 


: 198 ! ROUTINE GETFIELD ( 

3 171 «1 ELEM_TYPE, 

: 176 1 WORK STR 

3 175 «1 ) :CALL CCB = 

3 174 «1 

: 175 1 S46 

: 176 ! FUNCTIONAL DESCRIPTION: 

; 178 1! Parse out the next input data field based on the field terminators 

: 179 1! appropriate for the data type. Return the field with tabs and spaces 
; 890 180 1! stripped out in the area supplied by the calling routine. 

; +89 181 #1! A one is returned if a field was found. A zero is returned if an <eol> 
3; 89 : ; : is encountered before a field is found. 

; 894 is : FORMAL PARAMETERS: 

>; 896 186 1! ELEM_TYPE.rlu.v Type of element from List 

; 897 187 1! ELEM. wz.r Pointe of where to return the value 

; 898 188 1! May be a reference to a quadword or a descriptor 
; 899 189 1! WORK_STR.wt.rs Work string for parsing input string and resulting 
; 900 190 1! string for type text. 

: 901 191 1! 

3 aoe 136 1 ! IMPLICIT INPUTS: 

; 90 193 1! 
; 904 194 1! LUBSA_BUF _PTR current location in the buffer 

> 905 198 17! LUBSA_BUF _END perqver to last byte of buffer + 1 

: 906 1 1? RABSW_RSZ uffer size 

; 907 97 3! RABSW_STVO first word of STV field 

; 908 198 1! RABSW_STV2 second word of STV field 

g 84 138 i : I1SB$B8_STTM_TYPE 1/0 statement type in ISB 

: 911 $3 1 ! IMPLICIT OUTPUTS: 

3 at 8 1! 

; 91 eos 7} LUBSA_BUF _PTR Pointer to next byte in user buffer 

3 aie soe : 1SB$B8_ERR_NO first error found processing an I/O stmt. 

; 916 soe 1 ! ROUTINE VALUE: 

3; 917 207 1! 

; 918 208 1! 1 = a data field was ‘ound 

; 919 209 1! 0 = a data field was not found 

; 920 210 1! 

: 921 211 +1 =! COMPLETION CODES: 

3; 9 ¢ $i¢ 1! 

3; 9 13 1! NONE 

; 924 1461! 

; 925 15 1 ! SIDE EFFECTS: 

; 926 1461! 

3; 927 17 hUe NONE 

; 928 18 1: 

; 929 1 1 !e- 

; 930 0 1 

3; «931 . 3 '¢ , : ; 

3 aR8 § 1 ! Note: There are 3 exit points from this routine; not the best structure 
; 93 1 ' but that's the way it is. 

: 934 4 1 !- 

3; «935 5 1 


K 13 | 
oa seal 1e-$ep-1986 11:56:43 EBASRTLSSme SeASubraL-039; 1 song 


940 

941 

94 LOCAL 

94 DSC: BLOCK (8, BYTE), ! working desc. for parsing the input stream 

944 MASK, ! mask value for SCANC 

945 RET_VAL, ! yalue to return to caller 

ose LEN, ! Length of input record remaining to be scanned 
94 SCAN_VAL, ! return value from SCANC 

948 PTRS, } char pointer for source strin 


PTRD; ! char pointer for destination String 
'¢ | 
: mask values for the SCANC to stop on different characters 


LITERAL 
KC 


K-CHAR 
KINONE = % 
'¢ 


The element size of a longword integer 


FEESSESARARNAANDAL 
VIEWN—OOONOUSWN—OO 


POPOPIPIPIPOPINININNYINININININININININININPINIPIPINIPINIPIPPUPIPUPIPYPNYD 


SSDP PAA AAA AAA MAA & BEE PAA IIinononon) 
WN @§ OOO NAUVE WN $9 ODNAUE WN O OONAULS WN OOS NAULS WN OOONO 


RIPOPIPOPIPIPIPOPONDNYIAIMYNININIPYININPYAINNDNINININYNININIPYINIPYNIPOPIRIPYPIPUINIPIPINININIPIPYIPIPUPIPIPIPUPIPUNINYD 


BEGIN 

MAP 
WORK_STR: REF VECTOR CK_WORK_STR_LEN, BYTE], ! work area 
ELEM: REF VECTOR (2); T default ELEM to numeric 


967 K_INT_SIZ = 4, 

'¢ 
969 ! The flags for floating and integer input 
970 be 
971 K_INT_FLAGS = 5, 
972 KFLT“F_FLAGS = 123, 
973 2 K-FLTDFLAGS = 115; 
974 2 
975 2 BIND 
976 2 TABLE = UPLIT BYTE ( 
977 2 BX°20', EX°4O". BX'GO', ZX84O'. BX'GOT, AX'GO'? BX'4O', EX"4O", BX'4O", 
978 2 EX'10°, Ex'40") axfGO", axP4O", Zxh40". axf40', xx'40". | column 0 
979 é BGO", Bx'40", Bx'G0", axf40', ax'40", axh40". axh40") axf40", Ax'40', 
980 Bx'60", Ex"40" ax'40', axf40'. zxf40". axf40', ax'40") | column 4 
981 B10", x540") BxPGB") axF40") axGO', xxF40" axf4O', mxhade, Ax'40!", 
98 7 Bx'40", Ex'G0") axfGO', axfait. axf40'. axf40'. axf40'. | column 2 
98 7 2x°40". 2x'60". axfG0") axfGO', axfaO', axfao', axfao', mxf4d", Zx°40%, 
984 74 2x'40", ax"40") Bx 4g x'G0", ax'40', ax'40", ax'40") | column 3 
985 75 Bx'40", Ex'40", ax'O0", Ex'40", axf40". axf40". ExPGO', ax'40", Bx'40", 
986 7 Bx'60", Ex'40") ax'O0", axfG0') ax'40") axfao', mx'40") | column 4 
98 7 Bx'40", Ex540") BxfG0', Exf40". axfO0*, axf40". zxh40", axf40", 2x°40", 
988 78 BX'40", Ex'40", xx'40", axf40", Bx'40") Bx°40") ax'40') ! column 5 
989 7 x°40", Ex'60") ExfOO", Ex'60") Bx'40" BxPGO". Bx°G0', Ex'40", Bx'408, 
991 at aK'G0e BetGOe, BKE4Oe  HXEGOe EXEGOS, AKGDE  AKNGDE, BXEGOMC RK Oe 
992 $8) ax'40", ax'40", xxfoo", xxfG0", x840", Ax"40", Bx840". § Column 7 


13 


ASSSUDF _RL 16-Sep-1984 01:20:2 AX-11 Bliss-32 V4.0-74 Pa 6 
td 1 305-138 91:98:28 YOASRTL SRE SBASUDFAL 039; 1 = 3 
; 993 83 BX°4O", BX°40", 2X°40", AK°GO", AK°4O", AX°4O", Bx°4O", Fx°4O", EX'4O', 
3 9% 84 BX'40', 2x'40" x40" x40", ay" Bx" ax'40 ! column 8 
; 995 5 BX°GO"  BX°40' g 40". a 40°. ay 40°. a 40°, a 40". 3X 40°, %x'40", 
; 996 : BX°40' , SX°40" a 40°, BX°40' , EX'40". BX°40' ay 40°, + column 9 
; 997 BX'GO"  BXUGO" , BX'GO", AK°GO' BX'40" a 40°. a 40°, 2x 40", 3x"40" 
; 998 8 BX°40" , BX°40" a 40°. BY 40", 2x40". ax 40°. ay 40°. 3 column 16 
3 89 x40", EKPGO". axF40", AxFG0". axF40", axPGO". axh4d', axf4d", 2x40! 
; 1000 90 BXT4O", BX°40' , EXG0" Ex°40' ay 40°, BY 40°, 3X°40', } column 1 
; 1001 91 BX'GO"  BXEGO'  BXUGO', EKUGO" BXUGO' AK40" BX'40". BX 40", %x'40" 
; 1st 3 BXU4O"  EX4O!  EXUGO', AXGO" BX40" BX°40". ay 40°, : column 
; 100 9 BK'GO"  EXGO'  BXUGO' EXTGO' AXG0". BXGO' BX'40'. BX°40", 3X'40" 
; 1004 § 94 BX°40" EX°40', EX°40' By 40°, 2X40", Ex°40", y 40°, + column 1 
; 1005 95 BX'GO" BXUGO' EXUGO', EXUGO'. AX'GO' AXG0'. AX'40'. EX 40", %x'40" 
; 1006 $538 BX4O"  BXOG0'  EXUGO'  AXTGO'. AXG0'. AX'GO'. BX°40'. * column 1 
; 1007 $ 97 BK°GO"  AXUGO', AKG", AKTGO'. AX'GO'. AKG". AX'G0'. AX'40", IX'40!, 
; 1008 98 ZX°40", ZK'40", ZK'4O", ZK°40", 2K°40", 2x°40", 2X40" |! column 15 
; sed 2 +4 ): VECTORC256, BYTE); 
> 1011 $301 EXTERNAL REGISTER 
; a $308 CCB: REF BLOCK C, BYTE]; 

3 101 2305 2 
3 1014 304 1+ 
3 a $2 Initialize the default null string (zero length) 
3 1017 307 
; 1018 2308 DSCCDSC$W_LENGTH) = 0; 
; 1019 2309 
: 1020 2310 ‘+ 
; 1021 2311 2 ! Check to see if there is any more data in the record. P 
; 1058 $3i§ § ! If there is no more data (BUF_PTR GEQA BUF_END) then return a failure 
: Ise Saiz § status. Otherwise, increment BUF _PTR. 
; 1025 2315 2 
3 . CCBCLUBSA_BUF _ A .CCBCLUBSA_BUF _END 
1368 $318 IF .CCBCLUBSA_BUF _PTR] GEQA .CCBCLUBSA_BUF _END] 
; 1028 2318 2 RETURN 0 
; 59 2319 2 
; Ht $355 2 CCBCLUBSA_BUF _PTR] = .CCBCLUBSA_BUF _PTR] + 1; 
; 1936 2332 3 t+ 
; : Check for the buffer pointer equal to the end of the buffer (return default). 
103 232 f buf f i l h d of th ffer ( default) 
3 1034 2324 2 ! If the statement type is INPUT LINE, we will do all of the other processing. 
; 1036 2336 : For ans! vie no defaults should be applied. Signal the ‘too Little data‘ 
; ! error for ° 
3; 103 3 i 
: 1038 328 
3 544 330 IF ‘oe CL UBeA Bur Pra] caLa -CCB CLUBSA_BUF _END]) 
; 1021 331 HEN . 
; 1048 33 BASSSSIGNAL_IO (BASSK_TOOLITDAT); 
3 1044 334 IF (.CCBCLUBSA_BUF PTR] EQLA .CCBCLUBSA_BUF END)) 
; ine? $32 ae (.CCB CISBSB_STTM_TYPE] NEQ ISBSK_ST_TY_INL) 
; 1049 339 
3 1048 $35 1+ } 
3 1049 33 ' Return a zero or a null string as a default value 
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i la VenSep-1986 11:50:43 LeasmT oSResBASUDPAL 1659; 1 tag 


DSCSA_POINTER] = WORK_STRCOI; 
sELER_TYPE 
DSCSK-DTYPE_B TO DSCSK_DTYPE_H OF 


T 
NRANGE, OUTRANGE): 


ooo 


SOWDNAOUESWN “OOONOUS WN O0O~ 
Se ee 
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Piscsx_ptvPE 
DSCSK~DTYPE 
MASK = K 
COSCSK_DTYPE 
'¢ 


a DSCSK_DTYPE_L, DSCSK_DTYPE_F, DSCSK_DTYPE_D, 
. DSC$K-DTYPE-Pd: 
~ CE OR“K_NULC; 


J: = 


PMOPIPIPOPURININININIPOPIPUNUPPUPUND 
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First check for INPUT LINE, MAT LINPUT, or LINPUT. sag | return the whole Line regardless 
of the contents. Remove all leading tabs and spaces. Next check for 

quotes (single or double). They return 

everyseas up to the matched quote. The quotes themselves are not returned 

and the first one is stripped off by incrementing the buffer pointer. 

Otherwise, a field is delimited by a comma or <eol>. 

Trailing spaces and tabs are stripped off unquoted strings at great 

pain. 


IF .CCBCISB$B_STIM TYPE] EQL ISBS$K_ST_TY_LIN 
OR .CCBLISBSB_STTM TYPE] EGL ISBSR ST_TY_INL 
By 8 CISBSB_STTM_TYPE] EQL ISBS$R_ST_TY_MLI 


MASK = K_NONE 
ELSE 
BEGIN 


WAIN POPUP NUNOPYNOPUDY 2 2 2 PO St SS 


wr 
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+ 
!' Strip off the coating tabs, nulls, and spaces. If this results 
in a zero length string then return the null string. 


.CCB CLUBSA_BUF PTRI)<O 8,0> EQL xc ° 

B CLUBSA_BUF_PTR])<0,8,6> EQ. xc* 

B CLUBSA"BUF~PTR])<0.8.0> EQL %x'00") 
CLUBSA_GuF_PTR} LSS’ .¢cB CLUBSA_BUF_END) 

CCBCLUBSA_BUF_PTR] = .CCBCLUBSA_BUF PTR] + 1; 

IF .CCBCLUBSA-BUF~PTR] GEQ .CCBLLUBSA_BOF_END] 

708 . (, CCBCLUB$SA_BUF_PTR))<0,8,0> EQL7%C's' 


BEGIN 
Pp 


Sak ek ek ek halt ek hh ek ek ek ek hk 
BEES FEA inoponorory 


44 
BLE: REF BLOCK (8, BYTE]; 

ELEMCDSCS$W_LENGTH) = 0; 

RETURN 1; 


END; 
1F «(+ CEBLLUBSA_BUF_PTRI)<0, 8> EQL xc'""* 
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BASSSUDF _RL 1b-se -1984 01:20:2 AX-11 Bliss-32 V4.0-74 Pa 9 
passguo a aett 1 01:80:23 YBASRTL  SRe BASUDFRL.832;1 a (3 
3; 1164 tee 4 MASK = K_SGL eyorg: 

3 1165 455 4 CCBCLUBSA_BUF_PTR] = .CCBCLUBSA_BUF_PTR] + 1; 

; 1106 t2$ 4 END 

3; 116 45 ELSE 

3: 1168 +38 IF_.(.CCBCLUBSA_BUF_PTRJ)<O, 8> EQ. %c''” 

: 1392 45 THEN 

3; 1170 460 4 

3 1171 461 4 MASK = K_DBL eyort: 

: EE 462 4 CCBCLUBSA_BUF_PTR] = .CCBCLUBSA_BUF_PTR) + 1; 

: 117 465 & N 

3 1174 464 ELSE 

3 1175 465 MASK = K_COMMA; 

; 1109 466 END; 

3 117 467 TES; 

3: 1178 468 

3 1179 469 ‘+ 

; 1180 470 ! Point the character pointer to the start of the field. 

3: 1181 471 te 

3 Bt 247 

3; 118 247 § PTRS = CHSPTR(.CCBCLUBSA_BUF PTR); 

3 1186 2474 PTRD = CHSPTR(.DSCCDSC$A_POINTER]); 

: 1185 2475 § LEN = .CCBCLUBSA_BUF_END] - .CCBCLUBSA_BUF _PTRI; 

3; 1186 2476 

3; 1187 seoe 2 '¢ 

3 Ht rh 2 Based on the data type, scan the input data string for an element 

3 1190 $th0 | 

3: 1191 2481 ¢ WHILE 1 DO 

3 1138 et BEGIN 

3 119 24835 3 LITERAL 

3 1194 2484 3 K_DECIMAL_PT = %X'2E'; 

3 1195 2485 3% AL 

: 1196 2486 3 TEMP_LEN; ‘Used to allow > 64kb data 

+ 1197 2487 TEMP_LEN"= (IF .LEN GEQU 65536 THEN 65535 ELSE .LEN); 

; 1198 2488 H SCAN_VAL = SCANC(TEMP_LEN, .CCBCLUBSA_BUF _PTRI, TABLE, MASK); 

3 1199 2489 IF .SCAN_VAL NEQ 0 

3; 1200 2490 THEN 

3; 1201 2491 CASE .ELEM_TYPE 

3 1608 se38 As DSCSK_DTYPE_B TO DSCS$K_DTYPE_H OF 

3 1204 2494 ; CDSCSK_DTYPE_B, DSCSK_DTYPE_W, DSCSK_DTYPE_L, DSC$K_DTYPE_F 

; 1693 $t9e i aa DSCSK_DTYPE_G, DSCSK_DTYPE_H, DSC$K“DTYPE-P 3: 
3; 1207 2497 & CHSMOVE (.SCAN eS: me oe BUF _PTR], .PTRS, .PTRD);: 

3 1208 2498 5 IF .(.SCAN_VAL)<0, 8> EQC K_TAB) 

3; 1209 2499 5 OR (.(.SCAN_VAL)<O, 8> EQL K_SP) 

3 1210 2500 5 OR (.(.SCAN_VAL)<O, 8> EQL 2%'00") 

3 1211 $20) 4 THEN 

3 isi¢ 208 4 

3: 121 $20 4 '¢ , : 
3 1214 504 4 : A tab, null, or a space has been found in a numeric field 
3; 1215 282 & ! Strip it out. : : 

: : 18 259 ; Also strips out decimal points for packed decimal. 
: 1519 358 BEGIN 

> 1220 510 5 DSCCDSCS$W_LENGTH] = .DSCCDSC$W_LENGTH] + (.SCAN_VAL - .CCBCLUBSA_BUF _PTR]); 
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SANS 


MonsPorononofons: 


16- “19 
14 


1382 94:88:23 FAXSAT  Obheseke bear -g 


° 

pera gS ter BUF PTR] + 1); 
AN Vat - ,CCBCLUBSA_B0F _PTRI); 
Ut8 LUBSA, BUF _PTRI) e 1; 


X-11 Bliss-32 V4.0-74 Pp 0 
L. $3.1 net 3 


PTRS = CHSPLUS( 
PIRD = CHSPLUS( 
.P 


LEN = “Ng « 
CCBCLUBSA_BUF 
END 

ELSE 


IF .SCAN_VAL EQLU .CCBCLUBSA_BUF _PTRI 
THEN 


14 
! An element separator was encountered as the next character; 
} return the proper default value or the data scanned so far. 


BEGIN 
RET VAL = 1; 
EXITLOOP; 


END; 
DSCCDSC$wW LENGTH] = .DSCCDSC$W_LENGTH] + .SCAN_VAL - .CCBCLUBSA_BUF_PTRI; 
LEN = .LEN = (.SCAN_VAL = .CCBELUBSA_BUF_PTRJ)~= 1; 
CCBCLUBSA_GUS 959 = USCAN_VAL; 
RET_VAL = 1; 
EXITLOOP; 
END; 
END; 
CDSC$K_DTYPE_TJ: 
i Type text 


: Update the length so far, move the substring found, and 
check for a de.imiting quote if necessary. 


PICO 80 


L 

A_HIGH_MARK; ! High water mark of SCAN 

+ 

Strip off trailing spaces, nulls, and tabs if unquoted string 
A_HIGH_MARK = .SCAN_VAL; 

IF .MASK EQL K_COMMA 

THEN 

< 
8 
SCAN_VAL = .SCAN_VAL = 1; 


DSCCDSC$W_LENGTH) = .SCAN_VAL - .CCBCLUBSA_BUF PTR]; 

CHSMOVE (7SCAN_VAL = .CCBCLUBSA_BUF_PTRJ, 7PTRS, .PTRD); 

+4 

increment the buffer pointer if a delimiting quote is present 


1) 
OR .(.SCAN_VAL = 1)<0 
<0 
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| BASSSUDF _RL 16-Sep-1984 01:20:2 AX-11 Bliss-32 V4.0-74 Pa 1 
1-075 13288871984 94808 EBASRTL-SRe BASUDF RL »B3951 - 3) 
: 127 268 4 CCBCLUBSA_BUF PTR] = .A HIGH_MARK ; 

3 127 9 4 IF_.(.A_HIGH_MARK)<O, 85 EQL~2C'''* OR .(.A_HIGH_MARK)<O, 8> EQL %C°'" 

3; 1280 2 0 4 THEN 

; 1281 ar. 2 BEGIN 

; 128 276 2 LOCAL 

; 128 57 T_RET_VAL, H fenp return value from SCANC 

> 1284 574 é ! looking for Col taiting comma 

3; 1285 575 REM_LENGTH; : Lenase remaining in the buffer 

; i 86 226 3 ie CCBCLUBSA_BUF_PTR] = .CCBCLUBSA_BUF_PTR] + 1; 

; 1288 578 5 ! Scan for a comma, another character or the end-of-record following this quoted string. 
; \¢83 579 ! Set BUF_PTR to the address that the scan returns. If there is a comma, 

3; 1290 580 ! then it will be pointing at the comma. . ; 

3 } 4 28) 2 If there is a character other than space, tab or null following qoute, signal. 

: 1 38 388 5 MASK = K_COMMA OR K_CHAR; 

3 1294 584 5 REM_LENGTH = .LEN = .DSC COSC$W_LENGTH] - 1; 

: \¢3? 585 5 REM_LENGTH = (IF .REM_LENGTH GEQU 65536 THEN 65535 ELSE .REM_LENGTH); 
; 1296 586 5 T_RET_VAL = SCANC(REM_LENGTH, .CCB CLUBSA_BUF_PTR), 

3; 1297 2587 5 ABLE, MASK); 

3 1298 2588 5 CCB CLUBSA_BUF_PTR] = (IF .T_RET_VAL EQi 0 THEN .CC8 CLUBSA_BUF_END] + 1 ELSE .T_RET_VAL 
; 9.44 2589 5 F (.T_RET_VAL NEQ 0) AND 

; 1500 2590 6 (.(.T_RET_VAL)< 0 , 8 > NEQ %C°,") 

: 1301 391 5 THEN BASSS$STOP_IO (« BASSK_DATFORERR ); 

; 1308 236 4 ND; 

3; 130 2593 4 RET_VAL = 1; 

3 1304 2594 4&4 EXITLOOP; 

; 1305 2595 3 END; 

; 1306 2596 3 CINRANGE, OUTRANGE: 

3: 1307 2597 3 + 

; 1308 2598 3 ! Data types which are not supported 

3; 1309 2599 3 te 

3; 1310 2600 3 0; 

: 1311 2601 ; TES 

3 138 2602 ELSE 

; 131 2603 3 

3; 1314 2604 3 '¢ ‘gga 

5 1312 soba ; : The whole rest of the buffer was scanned without finding an element separator 
3; 1317 607 3 

3; 1318 2608 4 BEGIN 

3; 1319 609 4 LOCAL f 

: 1320 610 4 T_BUF _END; ! temp to hold BUF_END for deleting 

3; 1321 611 4 ' trailing nulls, Spaces, and tabs 

: 1322 612 4 T_BUF_END = .CCBCLUBSA_BUF_END); 

3; 132 613 4 

3 1324 614 4 '¢ ee 

3 1325 615 4 ' Check the mask value and if it indicates that this string is 

: 1326 616 4 ' bound by quotes, then check to see if LUBS PTR is not | 

; 1327 617 4 i equal to LUBSA BUF_END. The assumption is that~if BUF_PTR is 

: 1328 618 4 ' equal to BUF_ERND, Ehen a delimiting quote was not found but 

: 1329 619 4 ' rather the SCANC stopped on end-of-record. 

He Be 

; 1336 ? ¢ ? IF .MASK EQL K_DBL_QUOTE OR .MASK EQL K_SGL_QUOTE 

> 1334 $05 4 BASSS$STOP_10(BASSK_DATFORERR) ; 
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BASSSUDF _RL 1Se 1984 01:20:2 AX-11 Bliss-32 V4.0-74 Page 32 
O75 12286871384 9458032 EBASRTL SRE BASUDFAL 03551 ’ F 
; 1335 625 4 | 
3; 7% 6 § 4 4 | 
3 1 6 & ! $o far eyerything is OK. Move the data, then check for INPUT LINE 
; 1338 628 4 ! If this is an INPUT LINE, then we need to bump the Length based on 
; 1339 629 4 : the terminator and move the terminator into the buffer. 
3 ; ? ° ? } If INPUT then strip off the trailing spaces, nulls, and tabs 
:4 632 4 
3 1 rk 6 : 2 IF (.CCB rts fe aL bet EQL ISBSK_ST_TY_INP 
3 1344 634 -CCBLISBSB_STTM_TYPE) EQL ISBSK_ST_TY_REA) 
; ' 5 6 5 4 Ane -ELEM_TYPE EQL~DSCSK_DTYPE_T 
3 1 23 63 4 WHILE .(.7 BUF _END = 1)<0,8,0> EQL %C° ' 
; 1348 638 4 OR .(.T_BOF_ - 13<8 -8 -0? EQL %C' . 
3 1349 639 4 OR .(.T_BUF_END = 1)<0,8,0> EQL %x'00" 
; 1320 640 4 0 
; 1331 641 4 T_BUF_END = .T_BUF_END = 1; 
; 138 6435 4 DSCCDSC$W_LENGTH] = .DSCCOSC$W_LENGTH] + (.T_BUF_END - .CCBCLUBSA_BUF_PTRJ); 
3 1354 644 4 PTRD = CHSMOVE (.T_BUF_END - .CCBCLUBSA_BUF PTR], .PTRS, .PTRD); 
3 1355 2645 4 IF .CCBCISBSB_STTM_TYPE] EQL ISB$K_ST_TY_INC 
; 1356 sete 4 THEN 
3; 1357 647 4&4 
3; 1358 sete 4 '¢ : 
3; 1359 649 4&4 ! This is an INPUT LINE. Bump Length and tack on the terminator 
; 1360 2650 4 te 
; 1361 2651 4 
; 1306 $028 5 BEGIN 
; 136 653 5 LITERAL 
3 1364 2654 5 K_ESCAPE = %x‘1B", ! ASCII escape character 
; 1365 2655 5 K_CR = &x'OD', ! ASCII carriage return char. 
3 1366 2656 5 K-CRLF = %X'OAOD'; ' ASCII carriage return-Line 
3; 1367 2657 5 ! feed char. combination 
; 1368 2658 5 !+ 
; 1369 2659 5 ! Due to an undocumented change to RMS for V2.0, we want to look only at the 
; 1370 2660 5 ! low order oyte to find the terminating character. RMS is now returning the 
: 137) $06) 2 Length of the terminating sequence in the upper word. 
; 1398 $668 5 SELECTONEU .CCB CRABSW_STVO] OF 
3 1374 664 5 T 
3; 1375 665 5 CK_ESCAPE): 
; 1376 $06 6 BEGIN 
3; 1377 667 6 !+ . 
3 1378 668 6 ! Check to see if the length is one. If it is, we have to move the escape 
3; 1379 669 6 ! character by hand; it is not at the end of the buffer. Otherwise, the escape 
3 130 or ? : sequence is at the end of the buffer following the data. 
3 1356 672 6 IF .CCB CRABSW_STV2] EQLU 1 
; 138 67 § THEN 
3; 1584 674 BEGIN 
3; 1385 675 7 DSC COSC$W_LENGTH] = .DSC CDSC$W_LENGTH) + 1; 
3 1 a6 $76 7 CHSMOVE (1, UPLIT(K_ESCAPE), .PTRB); 
; 138 677 7 END 
3 1338 678 § ELSE 
3 1389 679 oesin 
; 1390 680 7 DSCCDSCS$W_LENGTH) = “pactescsy LENGTH] + sce CRABSW_STV2); 
3 1391 681 7 CHSMOVE (7CCB CRABSW_STV2), .CCB CRABSL_RBF) + .CCB CRABS$W_RSZ), .PTRD); 
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BASS EUDF RL 12-308- 1382 91:80:88 BASRTL .SRC IBASUDFRL.B3 31 3} | 
3 3 END; | 
1B i eo: 
: }896 e886 Geen 
; DSCLDSCSW_LENGTH] = .DSCCOSC$W_LENGTH] + 2; 
; 4 ea 3 CHSAOVE (2, UPLIT(K_CRLF), .PTRD); 
: 1399 689 : COTHERWI SE: 
ce Hg 
: 1208 $34 4 CCBCLUBS$A_BUF_PTR] = .CCBLLUBSA_BUF _END); 
: 14046 694 & RET_VAL = 1; 
Me RES Baron 
: 1407 697 Je END; ! WHILE loop 
: 1409 699 i Update the data pointer if this is a READ or MAT READ so that we are pointing 
3 8 m0 ! at the next data element in the event of an error. 
; ? F (.CCB CISBSB_STIM TYPE) EQL ISBSK_ST_TY_MRE) OR 
; 1218 $7 M Cte C1SB$B_STTM_TYPE) EQL ISB$K_ST_TY_REA) 
: 1414 3704 THEN 
GE 288 ah 
; 1419 $r0S 4 er oe tee Co, pyre) FIELD (BSF SMAJOR_FRAME) ; ! BASIC major frame pointer ; 
: 7? BMF = .C " ; 
: 1219 $705 ; BMF CBSFSA_CUR_DTA] =".CCB CLUBSA_BUF_PTR] + 1; 
3; 1420 2710 END; 
: 1491 grit 
: 1258 srig rm 
: ese site 3 Convert the field that was found into internal format | 
5 1426 2716 : | 
: 7 717 IF NOT (CASE .ELEM_TYPE 
; 1438 aa FROM DSCSK_DTYPE_B TO DSC$K_DTYPE_H OF 
: 1486 3720 ; CINRANGE, OUTRANGE): | 
: 1036 $358 ; i Data types that are not yet supported | 
: 14 724 4 BEGIN 
: 1438 132 ND; 
; 1437 rer CDSC$k_bTYPE_B): 
> 1439 729 i Integer - byte. 
3 1440 730 ! Do the conversion and then check the range. 
a 
: 1208 Fag 4 BEGIN 
+ 1444 734 4 IF OTS$CVT_TI_L(DSC, ELEMCO], K_INT_SIZ, K_INT_FLAGS) 
> 1445 735 & THEN 
S 1ed$ a39 r 
: 1448 738 4 i The conversion was successful. 
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IF “ELE GTR 127 
ee J] LSS -128 
BASSS$STOP_I0 (BASSK_ILLNUM) 


ELSE 
! signify success 
ELSE 
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'¢ 
The conversion routine returned failure. 


END; 
CDSC$K_DTYPE_w: 


i Integer - word 
! Do the conversion of the value input and then range check 
for overflow. 


SSSI NNN NNN NSS 
APXRPEMAAAAAIIVIIVT 


SNS 
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PN PP An 4S 
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BEGIN 
IF OTSSCVT_TI_L(DSC, ELEMLOJ, K_INT_SIZ, K_INT_FLAGS) 


1+ 
! The conversion was successful. Check the range of the 
value input. Signal an error or assume a value of success. 


SaANNG 


IF .ELEMCO) GIR 32767 
mo -LEMC) LSS -32768 


BASS$STOP_10 (BAS$K_ILLNUM) 


ELSE agit 
! signify success 
ELSE 


'¢ 


! The conversion routine returned failure. Assume a value of 
failure. 


SSNS 
COON NN NNN NNO 
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END; 
CDSC$K_DTYPE_LJ: 


le 
: patoger - longword. Upper and lower bounds checking is performed 
by the conversion routine. 
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5 } 4 32 CDSC$K_DTYPE_T, DSCSK_DTYPE_P): 

3 ! 65 2? String or packed = no conversion - just return success 
5 e 4 4 BEGIN 

; 1568 28 4 AP 

3; 1569 59 4 FLER: REF BLOCK (8, BYTE); 

; 1370 60 4 FLEM DSC$W_LENGTH) = .OSCCOSC$w_LENGTH); 
; 1571 861 4 

3 1306 £06 END; 

: 157 86 TESS 

: 120% 64 THEN 

3; 1575 65 BASSSSTOP_10(BAS$K_DATFORERR); 

; 1378 866 RETURN .RET_VAL; 

; 157 867 5 

> INFO#250 L1:2827 kos 

5 rerensenee REGISTER symbol RO is probably not initialized 


Referenced REGISTER symbol R1 is probably not initialized 
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0 1¢ «AE «3C OO1CE MOVZWL DSC, RO : 2529 
26 36 CO 00103 ADDL SCAN_VAL., RO : | 
1¢ AF g é A3 00106 SUBW3 © (RB)> RO, DSC : 
5 9 : 0108 SUBL3 RO EN, RO : 2530 
7 FF AO : O10F MOVAB -1(R0), LEN : | 
68 56 p gies MOVL SCAN_VAL, (R8) : 2531) 
0120 1 166 348: BRW $ t 2532) 
08 AE 6 DO OO1E9 35$:  MOVL § SCAN_VAL, A_HIGH_MARK 3 255 
01 OC AE D1 OO1ED CMPL MASK; #1 > 2553) 
15 12 001F1 BNE 38 : 
20 FF AG 91 OO1F3 36$ CMPB = =1(SCAN_VAL), #32 + 2555 
0B 13 001F7 BEQL  37$ : 
09 FF A6 91 O00O1F9 CMPB =1(SCAN_VAL), #9 ; 2556. 
05 13 001FD BEQL 378 : 
FF AG 95 OO1FF TSTB = = 1 (SCAN_VAL) + 2557 
04 12 90202 BNEQ 38$ F 
5 DY 00204 378: ECL —SCAN_VAL + 2559| 
EB 11 00 06 BRB 6 : 
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BASRTL.SRC 


ba Sap ity i Pi | 
PUNO UNMIS IU 
DDI AAT 
0.00 Cd Cd C0 CD CD 00 0900 0000 0D 
PARPARAARARAGAA 

ses 8s ee & &USehUCMhMhUCFMhU HhUC]MhUhFD 
eeeteeeceevece 


m 
rc 
m 
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DSC 
#4, OTSSCVT_TI_L 


* 59$ 
a Lem, #127 
@ELEM, #-128 

62$ 

# 

a 

ELEM 

DSC 

#4, OTSSCVT_TI_L 
RO, 59$ 

@ELEM, #32767 
@ELEM, #-32768 
69$ 
#BASSK_ILLNUM, -(SP) 
#1, BAS$S$STOP_I0 
65$ 

BS 

#4 

ELEM 

DSC 

#4, OTSSCVT_TI_L 
#123, =(SP) 

-(SP5 

T ELEM 

“5, QISScvT_T_p 
RO, 75$ 

ELEM 

T ELEM 

#2, LIBSCVTDF 
#115, -(SP) 
-144(CCB), -(SP) 
-(SP 

ELEM, R2 
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} 
I. 


SSBUOF AL 


; Routine Size: 


Name 
-BASSCODE 


File 


15 
1b-se -1984 01:20:2 AX-11 Bliss-32 V4.0-74 
12-8 08-1 9p 01:90:23 YBASRTL SRC IBASUDFRL.B3 31 
5 po 0400 PUSHL R2 
2c «AE OOF 0040F PUSHAB psc 
000000006 09 : F Q4ig CALLS #5, OTSSCVT_T_D 
0 p 041 MOVL RO, STATUS 
FF70 «CB 041 TSTB 3-144 (CCB) 
O¢ 13 004 BEQL 68s 
pd 04 PUSHL R 
000000006 00 01 FB 00424 CALLS #1, MTHSDINT 
$2 9 7D 00428 MOVG RO. (R2) 
é 53 £9 00408 68$:  BLBC status, 75$ 
3F 671 00431 698: BRB 6$ 
7E 73 gr 9A 904 3 O$: MOVZBL #115, -(SP) 
E 7C 004 CLRQ = (SPJ 
04 AC DD 00439 PUSHL ELEM 
2c AE 9F 0043C PUSHAB DSC 
000000006 00 05 FB 0043F CALLS #5, OTSSCVT_T_G 
13° («11 00446 71$ BRB $ 
7E 73. BF 9A 00448 728 MOVZBL #115, =(SP) 
7E 7C 0044C CLRQ = (SPJ 
04 AC DD 0044 PUSHL ELEM 
2C «AE OF 00451 PUSHAB DSC 
000000006 00 05 FB 00454 CALLS #5, OTSSCVT_T_H 
09 50 €9 00458 73$:  BLBC STATUS, 75$ 
12 11 00456 BRB 
04 BC 1C AE BO 00460 748 MOVW DSC, @ELEM 
OB 11 00465 BRB 76 
7E 00G 8F 9A 00467 75$ MOVZBL #BASS$K_DATFORERR, -(SP) 
000000006 00 01 FB 0046B CALLS #1, BASS$$STOP_IO 
50 10 AE D0 00472 76$:  MOVL  RET_VAL, RO 
04 00476 RET 
50 D4 00477 77$:  CLRL RO 
04 00479 RET 


1146: bytes, 


2868 1- END 
2869 0° ELUDOM 


Routine Base: _BASSCODE + 0494 


PSECT SUMMARY 


Bytes Attributes 
2318 NOVEC,NOWRT, RD, EXE, SHR, LCL, REL, 
Library Statistics 
esocsees Syabol§ eococee> Pages 


Mapped 


CON, PIC,ALIGN(2) 


Processing 
Time 
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4-S bot 984 BASRTL.SRC JBASUDFRL.83 31 (7) 
~-$255$0UA28: (SYSLIBISTARLET.L32;1 9776 22 0 581 00:01.2 
; Information: 
3; Warnings: 
; Errors: 


COMMAND QUALIFIERS 
BLISS/CHECK=(FIELD, INITIAL OPTIMIZE) /NOTRACE/LIS=L1S$:BASUDFRL/OBJ=OBJ$:BASUDFRL MSRC$:BASUDFRL/UPDATE=(ENH$:BASUDFRL) 


g670 0 
Size: 204 oress4” 275 data bytes 


Elapsed {tee 01: 40-2 
Lines/CPU Min: 3797 
sonenee Spares 25373 
"Y Used: 428 pages 
—_ ation Complete 


0032 ° H-BT13A-SE | T CORPORATION 
: VAX/ VMS V4.0 = PROPRIETARY 


